home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / data / happyps2 / xref.pas < prev   
Pascal/Delphi Source File  |  1994-06-01  |  15KB  |  336 lines
  1. {*********************************************************************
  2.  *  *** Pascal クロスリファレンサ ***                                *
  3.  *                                                                   *
  4.  *    sourceファイルを読み、名前の出現行を印字する。                 *
  5.  *    また、プログラムの構造に係わるような主な予約語の出現回数を     *
  6.  *    印字する。                                                     *
  7.  *      == 本来名前には有効範囲があり、それを意識した作りでなければ  *
  8.  *         完全ではないが、今後に期待したい                          *
  9.  *                                                                   *
  10.  *        HAPPyのサンプルプログラム                                  *
  11.  *          (作者  浅野比富美 Public Domain Software)                *
  12.  *********************************************************************}
  13.  
  14. program xref(source,output) ;
  15.  
  16.   const
  17.     MaxIDlen  = 10 ;                    { 名前の最大識別文字長 }
  18.                                         { HAPPyの名前の最大識別長は32だけど
  19.                                           長すぎて苦しいので10で我慢}
  20.     MinRSVlen =  2 ;                    { 予約語の最小文字長   }
  21.     MaxRSVlen = 10 ;                    { 予約語の最大文字長+1 }
  22.  
  23.   type
  24.     string = packed array[1..MaxIDlen] of char ; { 名前の文字列 }
  25.     chKind = (number,letter,other) ;    { 文字の種類  数字/英字/その他 }
  26.     symbol =                            { 予約語の種類及び名前 }
  27.              (IFsy,DOsy,OFsy,TOsy,INsy,ORsy,ENDsy,FORsy,VARsy,
  28.               DIVsy,MODsy,SETsy,ANDsy,NOTsy,NILsy,THENsy,
  29.               ELSEsy,WITHsy,GOTOsy,CASEsy,TYPEsy,FILEsy,
  30.               BEGINsy,UNTILsy,WHILEsy,ARRAYsy,CONSTsy,
  31.               LABELsy,REPEATsy,RECORDsy,DOWNTOsy,PACKEDsy,
  32.               PROGRAMsy,FUNCTIONsy,PROCEDUREsy,
  33.               identsy) ;
  34.     IDlistptr = ^IDlist   ;             { 名前のリストポインタ }
  35.     lnumptr   = ^lnumlist ;             { 行番号リストポインタ }
  36.     IDlist    = record                  { 名前のリスト }
  37.                   IDENT  : string    ;  {   名前       }
  38.                   lnump  : lnumptr   ;  {   行番号リストへのポインタ }
  39.                   leftp  : IDlistptr ;  {   小さい名前リストへのポインタ }
  40.                   rightp : IDlistptr ;  {   大きい名前リストへのポインタ }
  41.                 end ;
  42.     lnumlist  = record                  { 行番号リスト }
  43.                   lnum : integer ;      {   出現行番号   }
  44.                   next : lnumptr ;      {   次の行番号リストへのポインタ }
  45.                 end ;
  46.  
  47.   var
  48.     source     : text ;                    { Pascalソースファイル }
  49.     chtype     : array[char] of chKind ;   { 文字の種別表   }
  50.     rsv        : array[symbol] of          { 予約語テーブル }
  51.                    record nam   : string  ;{   予約語の名前 }
  52.                           count : integer ;{   出現カウンタ }
  53.                    end ;
  54.     rsvent     : array[MinRSVlen..MaxRSVlen]
  55.                    of symbol ;          { 長さ別予約語テーブルエントリ }
  56.     linenum    : integer     ;          { 行番号カウンタ }
  57.     inpchar    : char        ;          { 読み込み文字   }
  58.     ID         : string      ;          { 名前 }
  59.     clearID    : string      ;          { 名前格納エリアの空白初期化用ワーク }
  60.     root       : IDlistptr   ;          { 名前リストの根       }
  61.     WKidlist   : IDlist      ;          { 名前リストの作業用   }
  62.     WKlnumlist : lnumlist    ;          { 行番号リストの作業用 }
  63.  
  64. {******************************}
  65. {*        初期設定            *}
  66. {******************************}
  67.   procedure init ;
  68.     var c : char    ;                   { for文の制御変数 }
  69.         i : integer ;                   { for文の制御変数 }
  70.         s : symbol  ;                   { for文の制御変数 }
  71.   begin
  72.     rsv[IFsy       ].nam:='if        ' ; rsv[DOsy       ].nam:='do        ' ;
  73.     rsv[OFsy       ].nam:='of        ' ; rsv[TOsy       ].nam:='to        ' ;
  74.     rsv[INsy       ].nam:='in        ' ; rsv[ORsy       ].nam:='or        ' ;
  75.     rsv[ENDsy      ].nam:='end       ' ; rsv[FORsy      ].nam:='for       ' ;
  76.     rsv[VARsy      ].nam:='var       ' ; rsv[DIVsy      ].nam:='div       ' ;
  77.     rsv[MODsy      ].nam:='mod       ' ; rsv[SETsy      ].nam:='set       ' ;
  78.     rsv[ANDsy      ].nam:='and       ' ; rsv[NOTsy      ].nam:='not       ' ;
  79.     rsv[NILsy      ].nam:='nil       ' ; rsv[THENsy     ].nam:='then      ' ;
  80.     rsv[ELSEsy     ].nam:='else      ' ; rsv[WITHsy     ].nam:='with      ' ;
  81.     rsv[GOTOsy     ].nam:='goto      ' ; rsv[CASEsy     ].nam:='case      ' ;
  82.     rsv[TYPEsy     ].nam:='type      ' ; rsv[FILEsy     ].nam:='file      ' ;
  83.     rsv[BEGINsy    ].nam:='begin     ' ; rsv[UNTILsy    ].nam:='until     ' ;
  84.     rsv[WHILEsy    ].nam:='while     ' ; rsv[ARRAYsy    ].nam:='array     ' ;
  85.     rsv[CONSTsy    ].nam:='const     ' ; rsv[LABELsy    ].nam:='label     ' ;
  86.     rsv[REPEATsy   ].nam:='repeat    ' ; rsv[RECORDsy   ].nam:='record    ' ;
  87.     rsv[DOWNTOsy   ].nam:='downto    ' ; rsv[PACKEDsy   ].nam:='packed    ' ;
  88.     rsv[PROGRAMsy  ].nam:='program   ' ; rsv[FUNCTIONsy ].nam:='function  ' ;
  89.     rsv[PROCEDUREsy].nam:='procedure ' ;
  90.     for s:=IFsy to PROCEDUREsy do rsv[s].count := 0  ; { 予約語出現数クリア }
  91.  
  92.     rsvent[2]:=IFsy       ; rsvent[3]:=ENDsy       ; rsvent[4]:=THENsy ;
  93.     rsvent[5]:=BEGINsy    ; rsvent[6]:=REPEATsy    ; rsvent[7]:=PROGRAMsy ;
  94.     rsvent[8]:=FUNCTIONsy ; rsvent[9]:=PROCEDUREsy ;
  95.     rsvent[10]:=identsy   ; { 10文字用エントリはfor文のリピートのために必要}
  96.  
  97.     for c:=chr(0) to chr(255) do chtype[c] := other  ; { まず全部をその他に }
  98.     for c:='A'    to 'Z'      do chtype[c] := letter ; { 大文字は英字       }
  99.     for c:='a'    to 'z'      do chtype[c] := letter ; { 小文字は英字       }
  100.     for c:='0'    to '9'      do chtype[c] := number ; { 数字は  数字       }
  101.  
  102.     root    := nil ;                    { 名前リストの根の初期設定     }
  103.     with WKidlist,WKlnumlist do         { リスト作業用エリアの初期設定 }
  104.     begin
  105.      lnump := nil ; leftp := nil ; rightp := nil ; { WKidlist   }
  106.      next  := nil                                  { WKlnumlist }
  107.     end ;
  108.  
  109.     for i:=1 to MaxIDlen do clearID[i] := ' ' ;
  110.  
  111.     reset(source)  ;                    { ｿｰｽﾌｧｲﾙを検査ﾓｰﾄﾞにする  }
  112.     linenum := 1   ;                    { 行番号カウンタ初期化     }
  113.     inpchar := ' '                      { 読み込み文字を初期化     }
  114.   end {init} ;
  115.  
  116. {******************************}
  117. {*      名前取得              *}
  118. {******************************}
  119.   function  getID : Boolean ;           { eof時に偽  通常は真 }
  120.     label 999 ;                         { getID関数終了のラベル eof時飛ぶ }
  121.     var   kind : symbol ;               { 名前か予約語かの判断に使う }
  122.  
  123.   {******************************}
  124.   {*      1文字読み込み         *}
  125.   {******************************}
  126.     procedure nextch ;
  127.     begin
  128.       if eof(source) then goto 999 ;    { eof検出時 getID関数終了｡
  129.                                           Pascalではプログラムの最後が
  130.                                           end. だからこれで良い }
  131.       if eoln(source) then              { 改行コードの時 }
  132.       begin
  133.         readln(source) ;                { 改行コード読み飛ばし }
  134.         linenum := linenum + 1 ;        { 行番号カウントアップ }
  135.         inpchar := ' '                  { 空白に置き換え       }
  136.       end
  137.       else read(source,inpchar)         { 改行でなければそのまま読む }
  138.     end {nextch} ;
  139.  
  140.   {******************************}
  141.   {*      注釈読み飛ばし        *}
  142.   {******************************}
  143.     procedure skipcomment ;
  144.       var endflag : Boolean ;           { 注釈の終わりの時 真  }
  145.  
  146.     {****************************}
  147.     {*   ｼﾌﾄJISｺｰﾄﾞ1ﾊﾞｲﾄ目ﾁｪｯｸ  *}
  148.     {****************************}
  149.       function iskanji(ch:char) : Boolean ;
  150.       begin
  151.         iskanji := ( (chr(129)<=ch) and (ch<=chr(159)) ) or
  152.                    ( (chr(224)<=ch) and (ch<=chr(239)) )
  153.       end {iskanji} ;
  154.  
  155.     begin {skipcomment}
  156.       repeat
  157.         nextch ;
  158.         while iskanji(inpchar) do       { ｼﾌﾄJISｺｰﾄﾞの1バイト目ならば  }
  159.         begin
  160.           nextch ; nextch               { 2バイト分読み飛ばし          }
  161.         end ;
  162.         if inpchar = '*' then
  163.              endflag := (source^ = ')') or (source^ = '}')
  164.                             { source^ には次の文字が入っているのがミソ }
  165.         else endflag := inpchar = '}'
  166.       until endflag ;
  167.       nextch                            { nextchしなくてもうまくいく   }
  168.     end {skipcomment} ;
  169.  
  170.   {******************************}
  171.   {*      名前の処理            *}
  172.   {******************************}
  173.     function name : symbol ;
  174.       label 9 ;                         { 予約語の時jump  }
  175.       var   length : integer ;          { 名前の長さ      }
  176.              s     : symbol  ;          { for文の制御変数 }
  177.     begin
  178.       ID := clearID ;
  179.       WKlnumlist.lnum := linenum ;
  180.       length := 0 ;
  181.       repeat
  182.         if ('A'<=inpchar) and (inpchar<='Z') then { 大文字の時   }
  183.           inpchar:=chr(ord(inpchar)+ord(' ')) ;   { 小文字に変換 }
  184.         length := length + 1 ;
  185.         if length <= MaxIDlen then ID[length] := inpchar ; {最大長以降は無視}
  186.         nextch
  187.       until chtype[inpchar] = other ;
  188.       name := identsy ;
  189.       if length in [MinRSVlen..MaxRSVlen-1] then  { 予約語の長さ内にある時 }
  190.         for s:=rsvent[length] to pred(rsvent[length+1]) do
  191.           if ID = rsv[s].nam then       { 予約語の時 }
  192.           begin
  193.             name := s ;
  194.             rsv[s].count := rsv[s].count + 1 ; { 出現回数カウントアップ }
  195.             goto 9
  196.           end ;
  197.     9:end {name} ;
  198.  
  199.   begin {getID}
  200.     kind  := IFsy ;                     { とりあえず予約語の何かとする }
  201.     repeat                              { 名前が見つかるまで }
  202.       if       chtype[inpchar] = letter then  kind := name { 名前処理 }
  203.       else  if chtype[inpchar] = number then { 数字の時 }
  204.         repeat
  205.           nextch ;
  206.           if (inpchar='e') or (inpchar='E') then nextch
  207.         until chtype[inpchar] <> number
  208.       else  if inpchar = '''' then      { 文字列の時 }
  209.       begin                             { '自身を指定する時 '' とすること }
  210.         repeat                          { になっているので そこを考慮する }
  211.           repeat
  212.             nextch
  213.           until inpchar = '''' ;
  214.           nextch
  215.         until inpchar <> '''' ;
  216.         nextch
  217.       end
  218.       else  if inpchar = '{' then  skipcomment
  219.       else  if inpchar = '(' then
  220.       begin
  221.         nextch ;
  222.         if inpchar = '*' then skipcomment
  223.       end
  224.       else {if chtype[inpchar] = ohter  then} nextch
  225.     until kind=identsy ;
  226.   999 :                                 { eof検出時に飛んでくる }
  227.     getID := not eof(source)            { eofでなければ 名前は取れている }
  228.   end {getID} ;
  229.  
  230. {******************************}
  231. {*     名前の登録処理         *}
  232. {******************************}
  233.   procedure enterID(var tree : IDlistptr) ;      { 変数引数なのがミソ }
  234.  
  235.   {******************************}
  236.   {*    行番号リスト登録処理    *}
  237.   {******************************}
  238.     procedure enterNUM(var numlistp : lnumptr) ; { 変数引数なのがミソ }
  239.     begin
  240.       if numlistp = nil then            { 行番号リスト最後尾の時 }
  241.       begin
  242.         new(numlistp) ;
  243.         numlistp^ := WKlnumlist
  244.       end
  245.       else enterNUM(numlistp^.next)     { 途中を探している時 再帰呼び出し }
  246.     end {enterNUM} ;
  247.  
  248.   begin {enterID}
  249.     if tree = nil then                  { 登録する場所が見つかった時 }
  250.     begin
  251.       new(tree)         ;
  252.       tree^ := WKidlist ;
  253.       tree^.IDENT := ID ;
  254.       enterNUM(tree^.lnump)
  255.     end
  256.     else {if tree<>nil}                 { 登録する場所を探している時 }
  257.       with tree^ do
  258.         if      ID<IDENT then enterID(leftp)  { 今の名前が小さい時は左に登録}
  259.         else if ID>IDENT then enterID(rightp) { 今の名前が大きい時は右の登録}
  260.         else     {=}          enterNUM(lnump) { 同じ名前の時は行番号を登録  }
  261.   end {enterID} ;
  262.  
  263. {******************************}
  264. {*   クロスリファレンス印字   *}
  265. {******************************}
  266.   procedure print(tree : IDlistptr) ;
  267.  
  268.   {******************************}
  269.   {* １つの名前印字と行番号印字 *}
  270.   {******************************}
  271.     procedure printName ;
  272.       const width = 5       ;           { 行番号印字幅 }
  273.       var   lnump : lnumptr ;
  274.             colum : integer ;           { 出力済カラム (改行制御に使う) }
  275.     begin
  276.       write(tree^.IDENT)   ;
  277.       lnump := tree^.lnump ;
  278.       colum := MaxIDlen    ;
  279.       repeat                            { 行番号リストの終わりまで }
  280.         write(lnump^.lnum:width);
  281.         colum := colum + width  ;
  282.         lnump := lnump^.next    ;
  283.         if (lnump <> nil) and  (colum > 74) then
  284.         begin                           { 続きがあり、74カラムを越えていれば}
  285.           writeln ;                     { 次の行を名前の長さ分だけ進める    }
  286.           write(' ':MaxIDlen) ;
  287.           colum  := MaxIDlen
  288.         end
  289.       until lnump = nil ;
  290.       writeln
  291.     end {printName} ;
  292.  
  293.   begin {print}                         { 2分木をこのように処理すると  }
  294.     if tree <> nil then                 { アルファベット順に出力される }
  295.     begin                               { からおもしろい               }
  296.       print(tree^.leftp)  ;
  297.       printName ;
  298.       print(tree^.rightp)
  299.     end
  300.   end {print} ;
  301.  
  302. {******************************}
  303. {*     予約語出現回数印字     *}
  304. {******************************}
  305.   procedure printCount ;
  306.   begin
  307.     writeln ;
  308.     writeln('==== 主な予約語の出現回数 =====') ;
  309.     with rsv[RECORDsy   ] do writeln(nam,count:5) ;
  310.     with rsv[ARRAYsy    ] do writeln(nam,count:5) ;
  311.     with rsv[FILEsy     ] do writeln(nam,count:5) ;
  312.     with rsv[SETsy      ] do writeln(nam,count:5) ;
  313.     with rsv[PROCEDUREsy] do writeln(nam,count:5) ;
  314.     with rsv[FUNCTIONsy ] do writeln(nam,count:5) ;
  315.     with rsv[IFsy       ] do writeln(nam,count:5) ;
  316.     with rsv[ELSEsy     ] do writeln(nam,count:5) ;
  317.     with rsv[CASEsy     ] do writeln(nam,count:5) ;
  318.     with rsv[FORsy      ] do writeln(nam,count:5) ;
  319.     with rsv[WHILEsy    ] do writeln(nam,count:5) ;
  320.     with rsv[REPEATsy   ] do writeln(nam,count:5) ;
  321.     with rsv[WITHsy     ] do writeln(nam,count:5) ;
  322.     with rsv[GOTOsy     ] do writeln(nam,count:5)
  323.   end {printCount} ;
  324.  
  325. {******************************}
  326. {*        メイン処理          *}
  327. {******************************}
  328. begin {main}
  329.   init ;                                { 初期設定               }
  330.  
  331.   while getID do enterID(root) ;        { 名前を取り 登録        }
  332.                                         { ソースのeof検出で終わり}
  333.   print(root) ;                         { クロスリファレンス印字 }
  334.   printCount                            { 予約語出現回数印字     }
  335. end.
  336.